home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0769B.ZIP / VERTMENU.PRG < prev    next >
Text File  |  1987-10-02  |  5KB  |  106 lines
  1. * VERTMENU.PRG  USED TO CREATE VERTICAL MENU PROCEDURE
  2. * Copyright October 2, 1987, Gregory J. Scott
  3. * Placed into the public domain.
  4. mFIRSTLINE=4             && first line to write options on
  5. mLASTLINE=mFIRSTLINE+16  && last line to write options on
  6. mMESSAGE=mLASTLINE+2     && line to write option "help" messages on   
  7. mTITLE=SPACE(80)         && initialize title variable.
  8. mTITLErow=1              && row to write title on.
  9. mOUTFILE="VERTMOUT.PRG         " && output file. .prg is NOT assumed
  10. mINFILE="VERTMENU.DBF         "  && input database. .dbf is assumed.
  11. mMENUno="  "             && used to keep menu variables distinct.
  12. mPREFIX="PREFIX"         && procedure name prefix. vary with application
  13. mEXIT="Y"                && test for exit condition
  14. mCHOICE=1                && choice variable. corresponds to dbf record 
  15. mENDCHOICE=32            && maximum choices allowed.
  16. mLINE=1                  && screen line for @ say
  17. mOFFSET=2                && used to offest records 17-32
  18. @ 0, 0 clear
  19. @ 1,10 say "VERTMENU.PRG writes clipper code for PROMPT-MESSAGE menu's"
  20. @ 2,10 say "(Lotus style light bar with detail message)"
  21. @ 3,10 say "Demo menu dbf file MENU.DBF is provided to give an example."
  22. @ 6,10 say " Menu Parameter File " get mINFILE
  23. @ 6,55 say ".dbf default"
  24. @ 7,10 say " Output menu Program " get mOUTFILE
  25. @ 7,55 say "extension required"
  26. @ 8,10 say "         Menu Number " get mMENUno
  27. @ 9,10 say "  Application Prefix " get mPREFIX 
  28. @10,10 say "          Menu Title " get mTITLE    picture "@s40"
  29. @11,10 say "           Title Row " get mTITLErow picture "99"
  30. @12,10 say "          First Line " get mFIRSTLINE picture "99"
  31. @13,10 say "           Last Line " get mLASTLINE picture "99"
  32. @14,10 say "        Message Line " get mMESSAGE  picture "99"
  33. read
  34. if file(mOUTFILE)  && check to avoid overwriting file
  35.    @ 0, 0 clear
  36.    @01,10 say "Warning! This file exists. Erase it? (Y/N) " get mEXIT pict "!"
  37.    read
  38.    if mEXIT<>"Y"
  39.       return
  40.    endif
  41. endif
  42. if (.not. file(mINFILE)) .and. (.not. file(mINFILE+".dbf"))  && check exist
  43.    @ 0, 0 clear
  44.    @01,10 say "Warning! Menu Parameter file does not exist"
  45.    wait
  46.    return  
  47. endif
  48. use &mINFILE
  49. goto top
  50. mLINE=mFIRSTLINE              && begin writing options on first line allowed
  51. mCHOICE=1                     && option choice should correspond to recno()
  52. mENDCHOICE=iif(lastrec()<(32),lastrec(),32)  && num last choice in dbf 32 max
  53. @0,0 clear
  54. mOFFSET=2            && first column of choices
  55. set alternate on     && redirect printer output to file
  56. set alternate to &mOUTFILE  && name of output file
  57. ? "mMENU"+mMENUno+"=1"  && initialize menu memvar ~
  58. ? "set message to "+str(mMESSAGE,2,0) && setup option help message location
  59. ? "do while mMENU"+mMENUno+" <> "+str(mENDCHOICE,2,0)  && do menu while < max
  60. ? "    @ 0, 0 clear"                                   && redraw whole screen! 
  61. ? '    @ 1,'+str(40-int((len(rtrim(mTITLE))/2)),2,0)+' say "'+rtrim(mTITLE)+'"'
  62. do while (.not. eof()) .and. (mCHOICE<=mENDCHOICE) && write all menu choices
  63.    ? "* menu choice "+ str(mCHOICE,2,0)      && comment line
  64.    ? '   @ '+str(mLINE,2,0)+','+str(mOFFSET,2,0)+' prompt "'+PROMPT+'";'
  65.    ? '   message "'+MESSAGE+'"'  && actual menu choice (two lines: readable)
  66.    skip 1                        && skip to next menu choice.
  67.    mLINE=mLINE+1                 && increment counters
  68.    mCHOICE=mCHOICE+1
  69.    if mLINE=mLASTLINE            && if at bottom of column, goto top of screen
  70.       mLINE=mFIRSTLINE           &&  and change offset for 2nd column.
  71.       mOFFSET=42
  72.    endif
  73. enddo
  74. ? "   menu to mMENU"+mMENUno     && works like read on regular screen, but
  75.                                  && stores choice to memvar
  76. goto top             && redo procedure, writing cases for option consequences.
  77. mCHOICE=1
  78. ? "do case"
  79. do while (.not. eof()) .and. (mCHOICE<=mENDCHOICE)
  80.    ? "case mMENU"+mMENUno+" = "+ str(mCHOICE,2,0)+"  && "+MESSAGE
  81.    if DOPROC = "Y"   && do a procedure named for prefix and option number.
  82.       ? "do "+rtrim(mPREFIX)+ltrim(str(mCHOICE,2,0))
  83.    endif
  84.    if len(rtrim(command1))<>0  && write commands in dbf if not empty records
  85.       ? command1
  86.    endif
  87.    if len(rtrim(command2))<>0
  88.       ? command2
  89.    endif
  90.    if len(rtrim(command3))<>0
  91.       ? command3
  92.    endif
  93.    if len(rtrim(command4))<>0
  94.       ? command4
  95.    endif
  96.    if len(rtrim(command5))<>0
  97.       ? command5
  98.    endif
  99.    skip 1
  100.    mCHOICE=mCHOICE+1
  101. enddo
  102. ? "endcase"
  103. ? "enddo"
  104.  
  105. set alternate off  && set printing back to normal
  106.